home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d7 / exechk.arc / EXECHK.INC < prev    next >
Text File  |  1990-12-06  |  5KB  |  150 lines
  1.      (*******************************************************************
  2.  
  3.      Make sure we're working with an *.EXE file extension.
  4.  
  5.      *******************************************************************)
  6. procedure SetExeExt ( VAR S : string ) ;
  7. begin
  8.    S                         := Upper ( S ) ;
  9.    if pos ( '.EXE' , S ) = 0 then
  10.       S                      := S + '.EXE' ;
  11. end ;
  12.      (*******************************************************************
  13.  
  14.      Global OPEN and CLOSE, with error checking.
  15.  
  16.      *******************************************************************)
  17. function OpenFile ( VAR F : file ; S : string ) : boolean ;
  18. begin
  19.    OpenFile                  := FALSE ;
  20.    SetExeExt ( S ) ;
  21. {$I-}
  22.    assign ( F , S ) ;
  23.    reset ( F , 1 ) ;
  24. {$I+}
  25.    (*******************************************************************
  26.    Restoring FileMode to the our default AFTER the Reset allows the
  27.    calling procedure to set the FileMode if need be.
  28.    *******************************************************************)
  29.    FileMode                  := DefaultFileMode ;
  30.    if IOresult <> 0 then EXIT ;
  31.    OpenFile                  := TRUE ;
  32. end ;
  33.  
  34. procedure CloseFile ( VAR F : file ) ;
  35. begin
  36. {$I-}
  37.    Close ( F ) ;
  38. {$I+}
  39.    if IOresult <> 0 then
  40.       Abort ( 'Error closing file' ) ;
  41. end ;
  42.      (*******************************************************************
  43.  
  44.      File size function - from DOS.
  45.  
  46.      *******************************************************************)
  47. function FileBytes ( S : string ) : longint ;
  48. var
  49.    F                         : file ;
  50. begin
  51.    FileBytes                 := 0 ;
  52.    if not OpenFile ( F , S ) then EXIT ;
  53.    FileBytes                 := FileSize ( F ) ;
  54.    CloseFile ( F ) ;
  55. end ;
  56.      (*******************************************************************
  57.  
  58.      File size function - from EXE header.
  59.  
  60.      *******************************************************************)
  61. function ExeFileSize ( S : string ) : longint ;
  62. var
  63.    F                         : file ;
  64.    ExeHeader                 : ExeHeaderRec ;
  65.    W                         : word ;
  66. begin
  67.    ExeFileSize               := 0 ;
  68.    if not OpenFile ( F , S ) then EXIT ;
  69.    BlockRead  ( F , ExeHeader , SizeOf ( ExeHeader ) , W ) ;
  70.    CloseFile ( F ) ;
  71.    if W <> SizeOf ( ExeHeader ) then EXIT ;
  72.    with ExeHeader do
  73.    begin
  74.       if Signature <> $5A4D then EXIT ;          (* Not EXE format *)
  75.       if LengthRem = 0 then
  76.          ExeFileSize         := LongInt ( LengthPages ) shl 9
  77.       else
  78.          ExeFileSize         := ( LongInt ( Pred ( LengthPages ) ) shl 9 )
  79.                                   + LongInt ( LengthRem ) ;
  80.    end ;
  81. end ;
  82.      (*******************************************************************
  83.  
  84.      Seek with error checking.
  85.  
  86.      *******************************************************************)
  87. procedure SeekFile ( VAR F : file ; L : longint ) ;
  88. begin
  89. {$I-}
  90.    Seek ( F , L ) ;
  91. {$I+}
  92.    if IOresult <> 0 then
  93.       Abort ( 'Error during file SEEK' ) ;
  94. end ;
  95.      (*******************************************************************
  96.  
  97.      Append user-specific data to the end of the EXE file.
  98.  
  99.      *******************************************************************)
  100. procedure ExeInstallData     ( S : string ; VAR V ; NumBytes : longint ) ;
  101. var
  102.    F                         : file ;
  103.    BytesInExeHeader          : longint ;
  104. begin
  105.    BytesInExeHeader          := ExeFileSize ( S ) ;
  106.    FileMode                  := DefaultWriteMode ;
  107.    if not OpenFile ( F , S ) then
  108.       Abort ( 'Unable to open file ' + S ) ;
  109.    SeekFile ( F , BytesInExeHeader + 1 ) ;       (* 1 byte past EXE size *)
  110. {$I-}
  111.    BlockWrite ( F , V , NumBytes ) ;
  112. {$I+}
  113.    if IOresult <> 0 then
  114.       Abort ( 'Error writing to original file!' ) ;
  115.    CloseFile ( F ) ;
  116. end ;
  117.      (*******************************************************************
  118.  
  119.      Read user-specific data from the end of the EXE file, as reported
  120.      by the EXE header, NOT the actual DOS file size.
  121.  
  122.      *******************************************************************)
  123. procedure ExeReadData        ( S : string ; VAR V ; NumBytes : longint ) ;
  124. var
  125.    F                         : file ;
  126.    BytesInExeHeader          : longint ;
  127. begin
  128.    FillChar ( V , NumBytes , #0 ) ;
  129.    BytesInExeHeader          := ExeFileSize ( S ) ;
  130.    if not OpenFile ( F , S ) then
  131.       Abort ( 'Unable to open file ' + S ) ;
  132.    SeekFile ( F , BytesInExeHeader + 1 ) ;
  133. {$I-}
  134.    BlockRead ( F , V , NumBytes ) ;
  135. {$I+}
  136.    if IOresult <> 0 then
  137.       Abort ( 'Error reading file!' ) ;
  138.    CloseFile ( F ) ;
  139. end ;
  140.      (*******************************************************************
  141.  
  142.      A check to see if the EXE has already been "stamped".
  143.  
  144.      *******************************************************************)
  145. function IsExePersonalized ( S : string ) : boolean ;
  146. begin
  147.    IsExePersonalized         := ExeFileSize ( S ) <>
  148.                                 FileBytes ( S ) ;
  149. end ;
  150.